home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / fpc / sources.fpc / comp.sources.unix_1485_000004.msg < prev    next >
Text File  |  1993-08-09  |  52KB  |  1,582 lines
  1. Path: iam!chx400!cernvax!mcsun!uunet!bbn.com!rsalz
  2. From: rsalz@uunet.uu.net (Rich Salz)
  3. Newsgroups: comp.sources.unix
  4. Subject: v20i054:  Portable compiler of the FP language, Part05/06
  5. Message-ID: <2062@papaya.bbn.com>
  6. Date: 24 Oct 89 16:05:55 GMT
  7. Lines: 1572
  8. Approved: rsalz@uunet.UU.NET
  9.  
  10. Submitted-by: Edoardo Biagioni <biagioni@cs.unc.edu>
  11. Posting-number: Volume 20, Issue 54
  12. Archive-name: fpc/part05
  13.  
  14. #    This is a shell archive.
  15. #    Remove everything above and including the cut line.
  16. #    Then run the rest of the file through sh.
  17. -----cut here-----cut here-----cut here-----cut here-----
  18. #!/bin/sh
  19. # shar:    Shell Archiver
  20. #    Run the following text with /bin/sh to create:
  21. #    lib
  22. #    main
  23. echo shar: creating directory lib
  24. mkdir lib
  25. cd lib
  26. echo shar: extracting format.fp '(7684 characters)'
  27. sed 's/^XX//' << \SHAR_EOF > format.fp
  28. XX# format.fp: provides fpformat and fpscan, functions used to format
  29. XX# fp data for output or parse strings for input. It also provides
  30. XX# the type-discrimination functions symbol, number, character, boolean,
  31. XX# vector, string.
  32. XX# fpformat takes as input a list of atomic objects or strings (intermixed
  33. XX# at will) and produces a single string that contains the printable
  34. XX# form of each object. A symbol will become its name, a number will be
  35. XX# printed in decimal fixed or floating point format (depending on whether
  36. XX# it is a fixed or floating point number), a character will be printed as
  37. XX# such, a boolean as "true" or "false", and a string as itself. e.g.
  38. XX# fpformat: <"this is string ", number, ' , 1, ' , 'b, "ut also ", T> returns
  39. XX# "this is string number 1 but also true"
  40. XX# fpscan takes a pair: a format vector and an input string, and tries
  41. XX# to match entities in the format string to entities in the input string.
  42. XX# The format string may contain any one of the symbols: symbol, number,
  43. XX# integer, float, boolean, character; or it may contain a string or character.
  44. XX# Any string or character must be matched exactly; any symbol will be matched
  45. XX# to a symbol of the appropriate type, if possible. fpscan returns a pair:
  46. XX# the first is the vector of the elements that were matched, the second
  47. XX# is the unmatched part of the string. Notice that blanks are ignored
  48. XX# except as separators.
  49. XXDef symbol \/and o [atom, (bur >= A), (bur <= zzzzzzzzzzzzz)]
  50. XXDef number \/and o [atom, (bur > T), (bur < A)]
  51. XXDef character \/and o [atom, (bur < <>), (bur > zzzzzzzzzzzzz)]
  52. XXDef boolean and o [(bu = T), (bu = F)]
  53. XXDef vector or o [null, not o atom]
  54. XXDef string not o vector -> _F;
  55. XX       \/and o aa character
  56. XX
  57. XX# fpformat: <x, y, 'a> => "xya"
  58. XXDef fpformat append o aa formsingle
  59. XX
  60. XX# fpscan: <<format symbols or strings>, "string"> =>
  61. XX# <<matches>, "rest of string>
  62. XXDef fpscan null o 1 -> id;
  63. XX       null o 2 -> _<<>, <>>;
  64. XX       (null o 1 -> [_<>, 2 o 2];
  65. XX    # pass up: <<matches>, "rest of string">
  66. XX        [apndl o [1, 1 o 2], 2 o 2] o
  67. XX    # pass up: <element, <<matches>, "rest of string">>
  68. XX        [1, fpscan o 2]) o
  69. XX    # pass up: <element, <<rest of formats>, "rest of string">>
  70. XX       [1 o 1, [2, 2 o 1]] o
  71. XX    # pass up: <<element, "rest of string">, <rest of formats>>
  72. XX       [scanfirst o [1 o 1, 2], tl o 1]
  73. XX
  74. XX# scanfirst: <format "string"> => <match, "rest of string"> or <<>, "string">
  75. XXDef scanfirst (bu = symbol) o 1 -> scansymbol o 2;
  76. XX          (bu = number) o 1 -> scannumber o 2;
  77. XX          (bu = integer) o 1 -> scaninteger o 2;
  78. XX          (bu = float) o 1 -> scanfloat o 2;
  79. XX          (bu = boolean) o 1 -> scanboolean o 2;
  80. XX          (bu = character) o 1 -> scancharacter o 2;
  81. XX          character o 1 -> matchcharacter;
  82. XX          string o 1 -> matchstring;
  83. XX          bu error "illegal scan format used"
  84. XX
  85. XX# matchcharacter: <'c, "string"> => <'c, "string-tl"> or <<>, "string">
  86. XXDef matchcharacter (= o [1, 1 o 2] -> [1, tl o 2]; [_<>, 2]) o
  87. XX           [1, skipblanks o 2]
  88. XX
  89. XX# matchstring: <"s1", "s2"> => <"s1", "rest-of-s2"> or <<>, "s1">
  90. XXDef matchstring (= o [1, nhd o [length o 1, 2]] ->
  91. XX           [1, ntl o [length o 1, 2]];
  92. XX         [_<>, 2]) o
  93. XX        aa skipblanks
  94. XX
  95. XX# scansymbol: "string" => <symbol at start of string, "rest of string">
  96. XXDef scansymbol [implode o 1, 2] o breakblanks o skipblanks
  97. XX
  98. XX# scannumber: "string" => <number at start of string, "rest of string">, or
  99. XX# <<>, "string"
  100. XXDef scannumber (null o 1 -> scaninteger o 2; id) o scanfloat
  101. XX
  102. XX# scanboolean: "string" => <boolean, "rest of string"> or <<>, "string">
  103. XXDef scanboolean ((bur member "tTyY") o 1 -> [_T, 2 o breakblanks];
  104. XX         (bur member "fFnN") o 1 -> [_F, 2 o breakblanks];
  105. XX         [[], id]) o skipblanks
  106. XX
  107. XX# scancharacter: "string" => <first character, "tail of string">
  108. XXDef scancharacter [1, tl]
  109. XX
  110. XX# scaninteger: "string" => <integer at start of string, "rest of string">, or
  111. XX# <<>, "string"
  112. XXDef scaninteger ((bu = '-) o 1 -> [neg o 1, 2] o scannumber o tl;
  113. XX             (bu = '+) o 1 -> scannumber o tl;
  114. XX                 not o chardigit o 1 -> [[], id];
  115. XX             [\/+ o aa * o trans o [powerlist, aa scandigit] o 1, 2] o
  116. XX             breaknondig) o
  117. XX            skipblanks
  118. XX
  119. XX# scanfloat: "string" => <float at start of string, "rest of string">, or
  120. XX# <<>, "string">
  121. XXDef scanfloat (null o 2 -> id;
  122. XX           (bu = '.) o 1 o 2 -> scanfract o [1, tl o 2];
  123. XX           id) o
  124. XX          scaninteger
  125. XX
  126. XX# scanfract: <intpart, "fract+rest"> => <float, "rest">
  127. XXDef scanfract [+ o [1,
  128. XX            div o [1 o 2,
  129. XX                 (bu power 10.0) o - o aa length o [3, 2 o 2]]],
  130. XX           2 o 2] o
  131. XX    # pass up: <intpart, <fractpart, "rest">, "fract+rest">
  132. XX          [(bu * 1.0) o 1, scaninteger o 2, 2]
  133. XX
  134. XX# powerlist: "char1..charn" => <10**n-1, 10**n-2, ..., 10, 1>
  135. XXDef powerlist /(apndl o [* o [1, 1 o 2], 2]) o
  136. XX        (bur apndr <1>) o aa _10 o tl o iota o length
  137. XX
  138. XX# power: <base, exp> => base ** exp
  139. XXDef power (bu = 0) o 2 -> _1; \/* o aa 1 o distl o [1, iota o 2]
  140. XX
  141. XX# scandigit: 'digit => 0..9
  142. XXDef scandigit (bur - 1) o (bur index "0123456789")
  143. XX
  144. XX# skipblanks: "string" => string without leading blanks
  145. XXDef skipblanks while charspace o 1 tl
  146. XX
  147. XX# breakblanks: "string" => <string up to first blank, string from (incl.)>
  148. XXDef breakblanks [nhd, ntl] o
  149. XX        [((bu = 0) o 1 -> length o 2; (bur - 1) o 1) o
  150. XX          [(bu index ' ), id],
  151. XX         id]
  152. XX
  153. XX# breaknondig: "string" => <string up to first non-digit, string from (incl.)>
  154. XXDef breaknondig null -> _<<>, <>>;
  155. XX        chardigit o 1 ->
  156. XX            [apndl o [1, 1 o 2], 2 o 2] o [1, breaknondig o tl];
  157. XX        [_<>, id]
  158. XX
  159. XX# formsingle: object => "printable representation"
  160. XXDef formsingle string -> id;
  161. XX           vector -> (bu error "illegal input to fpformat");
  162. XX           character -> [id];
  163. XX           symbol -> explode;
  164. XX           (bu = T) -> _"true";
  165. XX           (bu = F) -> _"false";
  166. XX           = o [trunc, id] -> (bur inttostring 10);
  167. XX           floattostring
  168. XX
  169. XX# inttostring: <n base> => "xyz", a string corresponding to the printable
  170. XX# form, in the given base, of the number n.
  171. XXDef inttostring (bur < 0) o 1 ->
  172. XX            (bu apndl '-) o inttostring o [neg o 1, 2];
  173. XX        aa printdigit o reverse o makedigits
  174. XX
  175. XX# makedigits: <n base> => <dig1, dig2 .. dign>, where digx < base
  176. XXDef makedigits < -> [1]; apndl o [mod, makedigits o [div, 2]]
  177. XX
  178. XX# printdigit: n => the character corresponding to n (0 <= n < 16)
  179. XXDef printdigit 1 o (bur seln "0123456789ABCDEF") o
  180. XX           [(bu + 1), _1]
  181. XX
  182. XX# floattostring: n => the 
  183. XXDef floattostring append o [(bur inttostring 10) o trunc,
  184. XX                _".",
  185. XX                extend o [(bur inttostring 10), _3, _'0] o
  186. XX                 trunc o (bu * 1000) o - o [id, trunc]]
  187. XX
  188. XX# extend: <"string" l c> prepends as many copies of c as
  189. XX# necessary to make string have length l
  190. XXDef extend >= o [length o 1, 2] -> 1;
  191. XX       append o [aa 1 o distl o [3, iota o - o [2, length o 1]], 1]
  192. XX
  193. XXDef charalpha or o [charupper, charlower]
  194. XX
  195. XXDef charupper and o [(bur >= 'A), (bu >= 'Z)]
  196. XX
  197. XXDef charlower and o [(bur >= 'a), (bu >= 'z)]
  198. XX
  199. XXDef chardigit and o [(bur >= '0), (bu >= '9)]
  200. XX
  201. XXDef charhexdig \/or o [chardigit,
  202. XX             and o [(bur >= 'a), (bu >= 'f)],
  203. XX             and o [(bur >= 'A), (bu >= 'F)]]
  204. XX
  205. XXDef charoctdig and o [(bur >= '0), (bu >= '7)]
  206. XX
  207. XXDef charspace or o [(bu = ' ), (bu = '    )]
  208. XX
  209. XXDef tstformat [aa 2, \/and o aa =] o trans o [
  210. XX_<"hi there,
  211. XX274 high, 3.200 lo, 5.070 average, -247 octal, false, true
  212. XX",
  213. XX  "how do you compute prime numbers 13 and 17?
  214. XXa new result",
  215. XX  <<-3, hi, 5.1, -2.7, T, F, 'c, 'x, 2, 3.14156, "hi">, "lo">>,
  216. XX        [fpformat o
  217. XX         [_'h, _"i there,", newline, _274, _' , _high, _", ",
  218. XX          _3.2, _" lo, ", _5.07, _" average, ", _-247, _" octal, ",
  219. XX          _F, _',, _' , _T, newline],
  220. XX         fpformat o
  221. XX         [_"how do ", _"you compute", _" prime numbers ", _13,
  222. XX          _" and ", _17, _'?, newline, _"a new result"],
  223. XX         fpscan o
  224. XX         _<<number, symbol, number, number, boolean, boolean,
  225. XX            'c, character, integer, float, "hi", "hello">,
  226. XX           "-3 hi 5.1 -2.7 yes false cx 2 3.14156 hi lo">]]
  227. SHAR_EOF
  228. if test 7684 -ne "`wc -c format.fp`"
  229. then
  230. echo shar: error transmitting format.fp '(should have been 7684 characters)'
  231. fi
  232. echo shar: extracting lib.fp '(2384 characters)'
  233. sed 's/^XX//' << \SHAR_EOF > lib.fp
  234. XX# pairpos : <x1..xn> ==> <<1 x1>..<n xn>>
  235. XXDef pairpos null -> _<>; trans o [iota o length, id]
  236. XX
  237. XX# allpairs : <x1..xn> ==> <<<> x1> <x1 x2>..<xn <>>>
  238. XXDef allpairs trans o [(bu apndl <>), apndr o [id, _<>]]
  239. XX
  240. XX# ntl : <n <x1..xm>> ==> <xn+1..xm>
  241. XXDef ntl    append o aa (>= o [1, 1 o 2] -> _<>; [2 o 2]) o
  242. XX    distl o [1, pairpos o 2]
  243. XX
  244. XX# nhd : <n <x1..xm>> ==> <x1..xn>
  245. XXDef nhd append o aa (< o [1, 1 o 2] -> _<>; [2 o 2]) o
  246. XX    distl o [1, pairpos o 2]
  247. XX
  248. XX# seln : <<i l> <x1..xn>>, 1 <= i <= n, i + l <= n, l >= 0
  249. XX# ==> <xi..xi+l-1>
  250. XXDef seln nhd o [2 o 1, ntl o [- o [1 o 1, _1], 2]]
  251. XX
  252. XX# selectl: <i <x1..xn>>, 1 <= i <= n ==> xi
  253. XXDef selectl 1 o 2 o (while (bur > 1) o 1 [(bur - 1) o 1, tl o 2])
  254. XX
  255. XX# selectr: <<xn..x1> i>, 1 <= i <= n ==> xi
  256. XXDef selectr 1r o 2r o (while (bur > 1) o 1r [tlr o 2r, (bur - 1) o 1r])
  257. XX
  258. XX# poslen : <<i1..in><x1..xm>>, i1 = 1, in <= m ==>
  259. XX#    <<i1 i2-i1>..<in m+1-in>>
  260. XX# i.e. the data is almost ready for seln
  261. XXDef poslen trans o [1, aa - o trans o
  262. XX            [apndr o [tl o 1, (bu + 1) o length o 2], 1]]
  263. XX
  264. XX# breakup : <<i1..in><x1..xm>>, i1 = 1, in <= m ==>
  265. XX#    <<x1..xi2-1><xi2..xi3-1>..<xin..xm>>
  266. XXDef breakup aa seln o distr o [poslen, 2]
  267. XX
  268. XX# permute : <<i1 x1>..<in xn>> where {iy} = 1..n ==> <xj..xk>
  269. XX#    where ij = 1, ik = n and so on for the intermediate i's
  270. XXDef permute append o aa append o aa aa (= o [1 o 1, 2] -> [2 o 1]; _<>) o
  271. XX       aa distr o distl o [id, iota o length]
  272. XX
  273. XX# rank : <x <x1..xn>> ==> m where m is the number of xi's <= x
  274. XXDef rank \/+ o aa ( < -> _0; _1) o distl
  275. XX
  276. XXDef tstlib [trans, =] o
  277. XX       [[pairpos o _<7, 5, 3, 1>, ntl o _<2, <4, 5, 6, 8>>,
  278. XX         allpairs o _<1, 2, 3, 4, 5, 6, 7, 8, 9>, allpairs o _<1>,
  279. XX         nhd o _<2, <4, 5, 6, 8>>,
  280. XX         seln o _<<3, 4>, <1, 2, 3, 4, 5, 6, 7, 8>>,
  281. XX         selectl o _<5, <a, b, c, d, e, f, g>>,
  282. XX         selectr o _<<a, b, c, d, e, f, g>, 5>,
  283. XX         breakup o _<<1, 4, 6>, <1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>,
  284. XX         permute o _<<5, 9>, <2, 3>, <1, 1>, <4, 7>, <3, 5>>,
  285. XX         permute o _<<2, 3>, <1, 7>, <3, 5>>,
  286. XX         rank o _<4, <1, 2, 3, 4, 5, 6>>, rank o _<2, <5, 0, 4, 1>>],
  287. XX        _<<<1, 7>, <2, 5>, <3, 3>, <4, 1>>,
  288. XX           <6, 8>,
  289. XX           <<<>, 1>, <1, 2>, <2, 3>, <3, 4>, <4, 5>, <5, 6>, <6, 7>,
  290. XX        <7, 8>, <8, 9>, <9, <>>>,
  291. XX           <<<>, 1>, <1, <>>>,
  292. XX           <4, 5>,
  293. XX           <3, 4, 5, 6>,
  294. XX          e,
  295. XX          c,
  296. XX           <<1, 2, 3>, <4, 5>, <6, 7, 8, 9, 10>>,
  297. XX           <1, 3, 5, 7, 9>,
  298. XX           <7, 3, 5>,
  299. XX           4,
  300. XX           2>]
  301. SHAR_EOF
  302. if test 2384 -ne "`wc -c lib.fp`"
  303. then
  304. echo shar: error transmitting lib.fp '(should have been 2384 characters)'
  305. fi
  306. echo shar: extracting makefile '(2366 characters)'
  307. sed 's/^XX//' << \SHAR_EOF > makefile
  308. XXLIB = /usr/local/lib
  309. XXLIBS = ${LIB}/libfp.a ${LIB}/libnfp.a ${LIB}/libdfp.a
  310. XXSRC = lib.fp set.fp store.fp format.fp makefile nil
  311. XXTST = tstlib tststore tstset tstformat
  312. XXOBJ = lib.o store.o set.o format.o
  313. XXNOBJ = nlib.o nstore.o nset.o nformat.o
  314. XXDOBJ = dlib.o dstore.o dset.o dformat.o
  315. XX
  316. XXall: ${OBJ} ${NOBJ} ${DOBJ} ${TST}
  317. XX
  318. XXrelease: ${LIBS} ${TST}
  319. XX
  320. XXclean:
  321. XX    mkdir .tmp
  322. XX    mv ${SRC} .tmp
  323. XX    touch tmp
  324. XX    rm -f *
  325. XX    mv .tmp/* .
  326. XX    rmdir .tmp
  327. XX
  328. XX.SUFFIXES:
  329. XX
  330. XX# make ../src/fp.o explicitly depend on nothing, otherwise make
  331. XX# tries to make it from ../src/fp.c!
  332. XX../src/fp.o:
  333. XX    echo trying to make ../src/fp.o
  334. XX
  335. XXfp.o: ../fp.o
  336. XX    rm -f fp.o
  337. XX    cp ../fp.o .
  338. XX
  339. XXfpc: ../fpc
  340. XX    rm -f fpc
  341. XX    cp ../fpc .
  342. XX
  343. XXtstlib: lib.fp fp.o nil fpc
  344. XX    cp lib.fp tstlib.fp
  345. XX    fpc -m tstlib.fp
  346. XX    cc -o tstlib tstlib.c fp.o
  347. XX    rm -f tstlib.*
  348. XX    tstlib < nil | sed \$$!d
  349. XX
  350. XXtstset: set.fp fp.o nil fpc
  351. XX    cp set.fp tstset.fp
  352. XX    fpc -m tstset.fp
  353. XX    cc -o tstset tstset.c fp.o
  354. XX    rm -f tstset.*
  355. XX    tstset < nil | sed \$$!d
  356. XX
  357. XXtststore: store.fp fp.o nil fpc
  358. XX    cp store.fp tststore.fp
  359. XX    fpc -m tststore.fp
  360. XX    cc -o tststore tststore.c fp.o
  361. XX    rm -f tststore.*
  362. XX    tststore < nil | sed \$$!d
  363. XX
  364. XXtstformat: format.fp lib.o set.o fp.o nil fpc
  365. XX    cp format.fp tstformat.fp
  366. XX    fpc -mtstformat tstformat.fp
  367. XX    cc -o tstformat tstformat.c lib.o set.o fp.o
  368. XX    rm -f tstformat.*
  369. XX    tstformat < nil | sed \$$!d
  370. XX
  371. XX.SUFFIXES: .c .o
  372. XX
  373. XX.c.o: $*.c
  374. XX    cc -c -O ${CFLAGS} $*.c
  375. XX
  376. XXlib.c: lib.fp fpc
  377. XX    fpc lib.fp
  378. XX
  379. XXnlib.c: lib.fp fpc
  380. XX    cp lib.fp nlib.fp
  381. XX    fpc -n nlib.fp
  382. XX    rm -f nlib.fp
  383. XX
  384. XXdlib.c: lib.fp fpc
  385. XX    cp lib.fp dlib.fp
  386. XX    fpc -d dlib.fp
  387. XX    rm -f dlib.fp
  388. XX
  389. XXset.c: set.fp fpc
  390. XX    fpc set.fp
  391. XX
  392. XXnset.c: set.fp fpc
  393. XX    cp set.fp nset.fp
  394. XX    fpc -n nset.fp
  395. XX    rm -f nset.fp
  396. XX
  397. XXdset.c: set.fp fpc
  398. XX    cp set.fp dset.fp
  399. XX    fpc -d dset.fp
  400. XX    rm -f dset.fp
  401. XX
  402. XXstore.c: store.fp fpc
  403. XX    fpc store.fp
  404. XX
  405. XXnstore.c: store.fp fpc
  406. XX    cp store.fp nstore.fp
  407. XX    fpc -n nstore.fp
  408. XX    rm -f nstore.fp
  409. XX
  410. XXdstore.c: store.fp fpc
  411. XX    cp store.fp dstore.fp
  412. XX    fpc -d dstore.fp
  413. XX    rm -f dstore.fp
  414. XX
  415. XXformat.c: format.fp fpc
  416. XX    fpc format.fp
  417. XX
  418. XXnformat.c: format.fp fpc
  419. XX    cp format.fp nformat.fp
  420. XX    fpc -n nformat.fp
  421. XX    rm -f nformat.fp
  422. XX
  423. XXdformat.c: format.fp fpc
  424. XX    cp format.fp dformat.fp
  425. XX    fpc -d dformat.fp
  426. XX    rm -f dformat.fp
  427. XX
  428. XX${LIB}/libfp.a: ${OBJ}
  429. XX    ar ru ${LIB}/libfp.a ${OBJ}
  430. XX    ranlib ${LIB}/libfp.a
  431. XX
  432. XX${LIB}/libnfp.a: ${NOBJ}
  433. XX    ar ru ${LIB}/libnfp.a ${NOBJ}
  434. XX    ranlib ${LIB}/libnfp.a
  435. XX
  436. XX${LIB}/libdfp.a: ${DOBJ}
  437. XX    ar ru ${LIB}/libdfp.a ${DOBJ}
  438. XX    ranlib ${LIB}/libdfp.a
  439. XX
  440. XXnil:
  441. XX    echo \<\> > nil
  442. SHAR_EOF
  443. if test 2366 -ne "`wc -c makefile`"
  444. then
  445. echo shar: error transmitting makefile '(should have been 2366 characters)'
  446. fi
  447. echo shar: extracting nil '(3 characters)'
  448. sed 's/^XX//' << \SHAR_EOF > nil
  449. XX<>
  450. SHAR_EOF
  451. if test 3 -ne "`wc -c nil`"
  452. then
  453. echo shar: error transmitting nil '(should have been 3 characters)'
  454. fi
  455. echo shar: extracting set.fp '(3584 characters)'
  456. sed 's/^XX//' << \SHAR_EOF > set.fp
  457. XX# set.fp: defines, implements set operations on lists.
  458. XX# A set is a collection of possibly unrelated items. Items
  459. XX# may be added to this collection or deleted from it, or
  460. XX# the existence of an item may be inquired about.
  461. XX# An item is in the set if it is in the list at the top level.
  462. XX# For instance, x and <y z> are in the set <a x b <y z> x>,
  463. XX# but neither y nor z are in the set. Multiple copies of
  464. XX# an item are allowed in a set.
  465. XX# operations provided are:
  466. XX# member: <item set> returns whether the item is in the set.
  467. XX# include: <item set> returns a new set where the item has
  468. XX#    been apndl'd to the set unless it was already present.
  469. XX# exclude: <item set> returns a new set where the item has
  470. XX#    been deleted from the set if it was there, and the
  471. XX#    original set otherwise.
  472. XX# includem: <<item*> set> returns a new set where all the
  473. XX#    items have included, in the reverse order: in
  474. XX#    other words, the two lists are appended, and the
  475. XX#    first copy of any duplicates is then deleted.
  476. XX# excludem: <<item*> set> returns a new set where any
  477. XX#    item from item* is excluded.
  478. XX# index: <item set> returns the index (position) of
  479. XX#    the item in the set, or 0 if member would return false
  480. XX#    if several copies of the item are present, it returns the first
  481. XX
  482. XXDef member null o 2 -> _F;
  483. XX           \/or o aa = o distl
  484. XX
  485. XXDef include member -> 2; apndl
  486. XX
  487. XXDef exclude null o 2 -> 2;
  488. XX        append o aa (!= -> tl; _<>) o distl
  489. XX
  490. XXDef includem /include o apndr
  491. XX
  492. XXDef excludem /exclude o apndr
  493. XX
  494. XX# each set element becomes <pos <item element>>, then any that
  495. XX# match send up their value, then the first valid value is taken
  496. XXDef index null o 2 -> _0;
  497. XX          \/((bu = 0) o 1 -> 2; 1) o aa (= o 2 -> 1; _0) o
  498. XX      trans o [iota o length, id] o distl
  499. XX
  500. XXDef tstset [id, (\/and o aa = )] o
  501. XX        [[member o _<a, <>>, _F],
  502. XX         [member o _<x, <a, x, b, <y, z>, x>>, _T],
  503. XX         [member o _<<y, z>, <a, x, b, <y, z>, x>>, _T],
  504. XX         [member o _<y, <a, x, b, <y, z>, x>>, _F],
  505. XX         [member o _<z, <a, x, b, <y, z>, x>>, _F],
  506. XX         [include o _<a, <>>, _<a>],
  507. XX         [include o _<a, <b, c, d>>, _<a, b, c, d>],
  508. XX         [include o _<b, <b, c, d>>, _<b, c, d>],
  509. XX         [include o _<c, <b, c, d>>, _<b, c, d>],
  510. XX         [include o _<d, <b, c, d>>, _<b, c, d>],
  511. XX         [exclude o _<a, <>>, _<>],
  512. XX         [exclude o _<d, <b, c, d>>, _<b, c>],
  513. XX         [exclude o _<c, <b, c, d>>, _<b, d>],
  514. XX         [exclude o _<b, <b, c, d>>, _<c, d>],
  515. XX         [exclude o _<a, <b, c, d>>, _<b, c, d>],
  516. XX         [includem o _<<a, b, c>, <>>, _<a, b, c>],
  517. XX         [includem o _<<>, <>>, _<>],
  518. XX         [includem o _<<>, <b, c, d>>, _<b, c, d>],
  519. XX         [includem o _<<a>, <b, c, d>>, _<a, b, c, d>],
  520. XX         [includem o _<<a, b>, <b, c, d>>, _<a, b, c, d>],
  521. XX         [includem o _<<b, a>, <b, c, d>>, _<a, b, c, d>],
  522. XX         [includem o _<<c, z, b, a, d>, <b, c, d>>, _<z, a, b, c, d>],
  523. XX         [excludem o _<<a, b, c>, <>>, _<>],
  524. XX         [excludem o _<<>, <>>, _<>],
  525. XX         [excludem o _<<>, <b, c, d>>, _<b, c, d>],
  526. XX         [excludem o _<<a>, <b, c, d>>, _<b, c, d>],
  527. XX         [excludem o _<<a, b>, <b, c, d>>, _<c, d>],
  528. XX         [excludem o _<<b, a>, <b, c, d>>, _<c, d>],
  529. XX         [excludem o _<<c, z, b, a, d>, <b, c, d>>, _<>],
  530. XX         [index o _<a, <b, c, d>>, _0],
  531. XX         [index o _<a, <>>, _0],
  532. XX         [index o _<a, <a, b, c, d>>, _1],
  533. XX         [index o _<a, <a, a, c, d>>, _1],
  534. XX         [index o _<a, <a, b, a, d>>, _1],
  535. XX         [index o _<a, <a, b, c, a>>, _1],
  536. XX         [index o _<b, <a, b, c, d>>, _2],
  537. XX         [index o _<b, <a, b, b, d>>, _2],
  538. XX         [index o _<b, <a, b, c, b>>, _2],
  539. XX         [index o _<c, <a, b, c, d>>, _3],
  540. XX         [index o _<c, <a, b, c, c>>, _3],
  541. XX         [index o _<d, <a, b, c, d>>, _4]]
  542. SHAR_EOF
  543. if test 3584 -ne "`wc -c set.fp`"
  544. then
  545. echo shar: error transmitting set.fp '(should have been 3584 characters)'
  546. fi
  547. echo shar: extracting store.fp '(3838 characters)'
  548. sed 's/^XX//' << \SHAR_EOF > store.fp
  549. XX# A store is a place you can keep objects in and retrieve them
  550. XX# by key. A key should be an atom or a number -- later on
  551. XX# this may be extended.
  552. XX# newstore:x gives a (new) empty store
  553. XX# store:<<key value> store> stores the given value under key, possibly
  554. XX#    replacing a previous value with the same key
  555. XX# retrieve:<key store> returns the pair <key value> associated with
  556. XX#    the given key, or <> if the key is not in the store
  557. XX# unstore:<key store> removes the value with given key, if any.
  558. XX# allstored:store returns a list of pairs <key value>, one pair/key
  559. XX# storesize:store returns the number of values in the store
  560. XX# haskey:<key store> returns whether some value with the given key
  561. XX#    is in the store.
  562. XX# current implementation: a store is a tree of <key value left right>
  563. XX# where left and right are also trees.
  564. XX# invariant: all keys in left are < than key, all keys in right are >
  565. XX# than key.
  566. XX# no kind of tree balancing is done for now
  567. XX
  568. XXDef newstore _<>
  569. XX
  570. XXDef store null o 2 -> [1 o 1, 2 o 1, _<>, _<>];
  571. XX      = o [1 o 1, 1 o 2] -> [1 o 2, 2 o 1, 3 o 2, 4 o 2];
  572. XX      < o [1 o 1, 1 o 2] ->
  573. XX        [1 o 2, 2 o 2, store o [1, 3 o 2], 4 o 2];
  574. XX      [1 o 2, 2 o 2, 3 o 2, store o [1, 4 o 2]]
  575. XX
  576. XXDef retrieve null o 2 -> _<>;
  577. XX         = o [1, 1 o 2] -> [1, 2 o 2];
  578. XX         < o [1, 1 o 2] -> retrieve o [1, 3 o 2];
  579. XX         retrieve o [1, 4 o 2]
  580. XX
  581. XXDef unstore haskey -> unstaux; 2
  582. XX#unstaux is like unstore except it doesn't check for presence of key
  583. XXDef unstaux = o [1, 1 o 2] -> unstlift o 2;
  584. XX        < o [1, 1 o 2] -> [1 o 2, 2 o 2, unstaux o [1, 3 o 2], 4 o 2];
  585. XX        [1 o 2, 2 o 2, 3 o 2, unstaux o [1, 4 o 2]]
  586. XX# unstlift replaces each node with its left subtree, recursively
  587. XXDef unstlift null o 3 -> 4;    # we're at the end of left chaining.
  588. XX         [1 o 3, 2 o 3, unstlift o 3, 4]
  589. XX
  590. XXDef allstored null -> id; apndl o [[1, 2], append o aa allstored o [3, 4]]
  591. XX
  592. XXDef storesize null -> _0; (bu + 1) o + o aa storesize o [3, 4]
  593. XX
  594. XXDef haskey null o 2 -> _F;
  595. XX       = o [1, 1 o 2] -> _T;
  596. XX       < o [1, 1 o 2] -> haskey o [1, 3 o 2];
  597. XX                 haskey o [1, 4 o 2]
  598. XX
  599. XXDef tststore [id, (\/and o aa = )] o
  600. XX             [[haskey o [_1, store o [_<1, garble>, newstore]], _T],
  601. XX              [haskey o [_1, store o [_<2, garble>, newstore]], _F],
  602. XX              [retrieve o [_1, store o [_<2, garble>,
  603. XX                   store o [_<3, foo>, newstore]]], _<>],
  604. XX              [retrieve o [_2, store o [_<2, garble>, newstore]], _<2, garble>],
  605. XX              [retrieve o [_1, store o [_<2, garble>,
  606. XX                   store o [_<1, foo>, newstore]]], _<1, foo>],
  607. XX              [retrieve o [_2, store o [_<2, garble>,
  608. XX                   store o [_<1, foo>, newstore]]], _<2, garble>],
  609. XX              [retrieve o [_1, store o [_<1, foo>,
  610. XX                   store o [_<2, garble>, newstore]]], _<1, foo>],
  611. XX              [retrieve o [_2, store o [_<2, garble>,
  612. XX                   store o [_<1, foo>, newstore]]], _<2, garble>],
  613. XX              [allstored o store o [_<2, garble>, newstore], _<<2, garble>>],
  614. XX              [allstored o newstore, _<>],
  615. XX              [or, _T] o [(bu = <<a, b>, <c, d>>), (bu = <<c, d>, <a, b>>)] o
  616. XX               allstored o store o [_<a, b>, store o [_<c, d>, newstore]],
  617. XX          [storesize o newstore, _0],
  618. XX          [storesize o store o [_<1, useless>, newstore], _1],
  619. XX              [storesize o store o [_<a, b>, store o [_<c, d>, newstore]], _2],
  620. XX              [storesize o unstore o [_a, store o [_<c, d>, newstore]], _1],
  621. XX              [storesize o unstore o [_a, store o [_<a, b>, newstore]], _0],
  622. XX              [allstored o unstore o [_a, store o [_<a, b>,
  623. XX                      store o [_<c, d>, newstore]]],
  624. XX           _<<c, d>>],
  625. XX              [allstored o unstore o [_c, store o [_<a, b>,
  626. XX                      store o [_<c, d>, newstore]]],
  627. XX           _<<a, b>>],
  628. XX              [allstored o unstore o [_c, store o [_<c, d>, newstore]], _<>],
  629. XX              [allstored o unstore o [_a, store o [_<c, d>, newstore]],
  630. XX           _<<c, d>>]
  631. XX             ]
  632. SHAR_EOF
  633. if test 3838 -ne "`wc -c store.fp`"
  634. then
  635. echo shar: error transmitting store.fp '(should have been 3838 characters)'
  636. fi
  637. echo shar: done with directory lib
  638. cd ..
  639. echo shar: creating directory main
  640. mkdir main
  641. cd main
  642. echo shar: extracting cart.fp '(135 characters)'
  643. sed 's/^XX//' << \SHAR_EOF > cart.fp
  644. XXDef distribute append o (aa (aa apndl)) o (aa distl) o distr
  645. XXDef cart (null o tl -> (aa [id]) o 1;
  646. XX             distribute o [1, cart o tl])
  647. SHAR_EOF
  648. if test 135 -ne "`wc -c cart.fp`"
  649. then
  650. echo shar: error transmitting cart.fp '(should have been 135 characters)'
  651. fi
  652. echo shar: extracting cart1.fp '(345 characters)'
  653. sed 's/^XX//' << \SHAR_EOF > cart1.fp
  654. XX# this one comes from the paper "Structuring FP-style functional
  655. XX# programs", by A. C. Fleck, Comp. Lang., Vol. 11, No. 2, pp. 55-63,
  656. XX# 1986, where it is called dir_prod (direct product).
  657. XX#
  658. XX# note: unlike cart, it only does the cartesian product of two
  659. XX# (instead of infinitely many) vectors.
  660. XXDef cart1 (null -> id; \/append) o aa distl o distr
  661. SHAR_EOF
  662. if test 345 -ne "`wc -c cart1.fp`"
  663. then
  664. echo shar: error transmitting cart1.fp '(should have been 345 characters)'
  665. fi
  666. echo shar: extracting extra.fp '(1044 characters)'
  667. sed 's/^XX//' << \SHAR_EOF > extra.fp
  668. XXDef extra [id, \/and] o [tstappend, tstimplode, tstexplode]
  669. XX
  670. XXDef tstappend \/and o aa = o trans o
  671. XX          [aa append o
  672. XX           _<<<>>,
  673. XX         <<>, <>, <>, <>, <a, b, c, d, e>>,
  674. XX         <<a, b>, <c, d>, <e, f>, <g, h>, <i, j>>,
  675. XX         <<<a, b>, <c, d>>, <<e, f>, <g, h>>, <i, j>>,
  676. XX         <<<a, b>, <c, d>>, <<e, f>, <g, h>>, <<i, j>>>,
  677. XX         <<>, <>, <>, <>, <>>,
  678. XX         <<a, b, c>, <d, e, f>, <>>,
  679. XX         <<a, b>, <c, d>>>,
  680. XX           _<<>,
  681. XX         <a, b, c, d, e>,
  682. XX         <a, b, c, d, e, f, g, h, i, j>,
  683. XX         <<a, b>, <c, d>, <e, f>, <g, h>, i, j>,
  684. XX         <<a, b>, <c, d>, <e, f>, <g, h>, <i, j>>,
  685. XX         <>,
  686. XX         <a, b, c, d, e, f>,
  687. XX         <a, b, c, d>>]
  688. XX
  689. XXDef tstimplode \/and o aa = o trans o
  690. XX    [aa implode o
  691. XX     _<"hello",
  692. XX       "hi",
  693. XX       "myname",
  694. XX       "here_I_am",
  695. XX       "hi there">,
  696. XX     apndr o [(bu apndr <hello, hi, myname>) o implode o _"here_I_am",
  697. XX          implode o _"hi there"]]
  698. XX
  699. XXDef tstexplode \/and o aa = o trans o
  700. XX    [aa explode o
  701. XX     apndr o [(bu apndr <hello, hi, myname>) o implode o _"here_I_am",
  702. XX            implode o _"hi there"],
  703. XX     _<"hello",
  704. XX       "hi",
  705. XX       "myname",
  706. XX       "here_I_am",
  707. XX       "hi there">]
  708. SHAR_EOF
  709. if test 1044 -ne "`wc -c extra.fp`"
  710. then
  711. echo shar: error transmitting extra.fp '(should have been 1044 characters)'
  712. fi
  713. echo shar: extracting fib.fp '(65 characters)'
  714. sed 's/^XX//' << \SHAR_EOF > fib.fp
  715. XXDef fib (bu >= 1) -> id;
  716. XX    + o [fib o (bur - 1), fib o (bur - 2)]
  717. SHAR_EOF
  718. if test 65 -ne "`wc -c fib.fp`"
  719. then
  720. echo shar: error transmitting fib.fp '(should have been 65 characters)'
  721. fi
  722. echo shar: extracting flatten.fp '(58 characters)'
  723. sed 's/^XX//' << \SHAR_EOF > flatten.fp
  724. XXDef flatten null -> id; atom -> [id]; append o aa flatten
  725. SHAR_EOF
  726. if test 58 -ne "`wc -c flatten.fp`"
  727. then
  728. echo shar: error transmitting flatten.fp '(should have been 58 characters)'
  729. fi
  730. echo shar: extracting histo.fp '(1066 characters)'
  731. sed 's/^XX//' << \SHAR_EOF > histo.fp
  732. XXDef histo puthisto o countns o breakwords
  733. XX
  734. XX# breakwords : <"string with blank-separated words"> => <vector of words>
  735. XXDef breakwords append o
  736. XX           aa ((bu = ' ) o 1 -> [tl];
  737. XX           (bu = " ") -> _<>;
  738. XX           = o [newline, id] -> _<>;
  739. XX           [id]) o
  740. XX           breakup o
  741. XX           [((bu = 1) o 1 -> id; (bu apndl 1)) o allblanks, id]
  742. XX
  743. XX# countns: <string*> => <#stringsoflength=pos*>
  744. XXDef countns aa (\/+ o aa (= -> _1; _0) o distl) o
  745. XX# passing up <<1, <...>>, <2, <...>>, .. <n, <...>>>,
  746. XX# where <...> stands for the array of lengths
  747. XX        distr o [iota o \/maxnum, id] o aa length
  748. XX
  749. XX# puthisto: <n1..nq> => <histogram with q lines, each n1 to nq long>
  750. XX# if max (n1..nq) > 72, then scaling is used to reduce the max to 72
  751. XXDef puthisto (bur > 72) o \/maxnum ->
  752. XX        puthisto o aa (trunc o *) o
  753. XX        distr o [id, (bu div 72.0) o \/maxnum];
  754. XX         append o aa (append o [aa _'# o iota, newline])
  755. XX
  756. XX# allblanks: "string" => <position of blank in string*>
  757. XXDef allblanks append o
  758. XX          aa ((bu = ' ) o 2 -> tlr;
  759. XX          = o [1 o newline, 2] -> tlr;
  760. XX          _<>) o
  761. XX          pairpos
  762. XX
  763. XXDef maxnum > -> 1; 2
  764. SHAR_EOF
  765. if test 1066 -ne "`wc -c histo.fp`"
  766. then
  767. echo shar: error transmitting histo.fp '(should have been 1066 characters)'
  768. fi
  769. echo shar: extracting makefile '(151 characters)'
  770. sed 's/^XX//' << \SHAR_EOF > makefile
  771. XXFPFLAGS =
  772. XXFPRTS = ../fp.o
  773. XX
  774. XX.SUFFIXES:
  775. XX
  776. XX.SUFFIXES: .fp .run
  777. XX
  778. XX.fp.run: $*.fp
  779. XX    fpc -m ${FPFLAGS} $*.fp
  780. XX    cc -o $* ${CFLAGS} $*.c ${FPRTS}
  781. XX    rm -f $*.c $*.o
  782. SHAR_EOF
  783. if test 151 -ne "`wc -c makefile`"
  784. then
  785. echo shar: error transmitting makefile '(should have been 151 characters)'
  786. fi
  787. echo shar: extracting mat.out '(82 characters)'
  788. sed 's/^XX//' << \SHAR_EOF > mat.out
  789. XX<<40, 34, 28, 22>,
  790. XX<112, 97, 82, 67>,
  791. XX<184, 160, 136, 112>,
  792. XX<256, 223, 190, 157>>
  793. SHAR_EOF
  794. if test 82 -ne "`wc -c mat.out`"
  795. then
  796. echo shar: error transmitting mat.out '(should have been 82 characters)'
  797. fi
  798. echo shar: extracting mat.tst '(239 characters)'
  799. sed 's/^XX//' << \SHAR_EOF > mat.tst
  800. XX<<<1, 2, 3>,
  801. XX  <4, 5, 6>,
  802. XX  <7, 8, 9>,
  803. XX  <10, 11, 12>>,
  804. XX <<12, 11, 10, 9>,
  805. XX  <8, 7, 6, 5>,
  806. XX  <4, 3, 2, 1>>>
  807. XX
  808. XXexpected result of matrix multiplication is:
  809. XX<<40, 34, 28, 22>,
  810. XX <112, 97, 82, 67>,
  811. XX <184, 160, 136, 112>,
  812. XX <256, 223, 190, 157>>
  813. SHAR_EOF
  814. if test 239 -ne "`wc -c mat.tst`"
  815. then
  816. echo shar: error transmitting mat.tst '(should have been 239 characters)'
  817. fi
  818. echo shar: extracting mmult.fp '(100 characters)'
  819. sed 's/^XX//' << \SHAR_EOF > mmult.fp
  820. XXDef IP (/+) o (aa *) o trans
  821. XX
  822. XXDef MM (aa aa IP) o (aa distl) o distr o [1, trans o 2]
  823. XX
  824. XXDef mmult MM
  825. SHAR_EOF
  826. if test 100 -ne "`wc -c mmult.fp`"
  827. then
  828. echo shar: error transmitting mmult.fp '(should have been 100 characters)'
  829. fi
  830. echo shar: extracting msort.fp '(232 characters)'
  831. sed 's/^XX//' << \SHAR_EOF > msort.fp
  832. XXDef msort    # mergesort: <n1, n2, .., nx> => <ni, nj, .., nq>, sorted
  833. XX    \/ merge o aa [id]
  834. XX
  835. XXDef merge null o 1 -> 2;
  836. XX      null o 2 -> 1;
  837. XX      < o aa 1 -> apndl o [1 o 1, merge o [tl o 1, 2]];
  838. XX                apndl o [1 o 2, merge o [1, tl o 2]]
  839. SHAR_EOF
  840. if test 232 -ne "`wc -c msort.fp`"
  841. then
  842. echo shar: error transmitting msort.fp '(should have been 232 characters)'
  843. fi
  844. echo shar: extracting newsels.fp '(157 characters)'
  845. sed 's/^XX//' << \SHAR_EOF > newsels.fp
  846. XXDef min \/( < -> 1; 2)
  847. XXDef exclude append o aa ( = -> _<>; tl) o distl
  848. XXDef newsels (bu >= 1) o length -> id;
  849. XX        apndl o [1, newsels o exclude] o [min, id]
  850. SHAR_EOF
  851. if test 157 -ne "`wc -c newsels.fp`"
  852. then
  853. echo shar: error transmitting newsels.fp '(should have been 157 characters)'
  854. fi
  855. echo shar: extracting nil '(3 characters)'
  856. sed 's/^XX//' << \SHAR_EOF > nil
  857. XX<>
  858. SHAR_EOF
  859. if test 3 -ne "`wc -c nil`"
  860. then
  861. echo shar: error transmitting nil '(should have been 3 characters)'
  862. fi
  863. echo shar: extracting nqueens.fp '(1801 characters)'
  864. sed 's/^XX//' << \SHAR_EOF > nqueens.fp
  865. XX# nqueens.fp: gives all solutions for placing n queens on an nxn
  866. XX# chessboard in such a way that they do not threaten each other
  867. XX# Typical call:
  868. XX# nqueens 8
  869. XX
  870. XX# nqueens : n => board printout, or nil
  871. XXDef nqueens prtboards o nmqueens o [id, id]
  872. XX
  873. XX# nmqueens : <n, m> => list of n safe row positions for n queens on an
  874. XX# n-column by m-row chessboard. Precondition: n <= m
  875. XX# e.g., nmqueens : <2, 3> => <<1, 3>, <3, 1>>
  876. XXDef nmqueens (bu = 1) o 1 -> aa [id] o iota o 2;
  877. XX         append o aa (null -> id; [id]) o aa safe o
  878. XX        append o aa distl o distr o
  879. XX        [iota o 2, nmqueens o [(bur - 1) o 1, 2]]
  880. XX
  881. XX# safe : <row, rowpositions> => <row | rowpositions> if safe, <> otherwise
  882. XX# e.g. safe : <3, <1, 4, 7>> => <3, 1, 4, 7>, safe : <3, <4, 1, 7>> => <>
  883. XXDef safe \/and o aa saferow o aa apndl o pairpos o distl -> apndl ; _<>
  884. XX
  885. XX# pairpos : <x1..xn> ==> <<1 x1>..<n xn>>
  886. XXDef pairpos null -> _<>; trans o [iota o length, id]
  887. XX
  888. XX# saferow : <col, row@col1, row@col> => whether a queen placed at
  889. XX# (row@col1, 1) is safe from one at (row@col, col)
  890. XXDef saferow \/and o aa != o [tl, [1, - o tl], [1, neg o - o tl]]
  891. XX
  892. XX# prtboards : <rowlist1..rowlistn> => board1 ++ newline ++ .. ++ boardn
  893. XXDef prtboards null -> _"no solution found"; mergelines o aa prtboard
  894. XX
  895. XX# prtboard : <row1..rown> => printed form of the board, where Q represents
  896. XX# a position, _ a blank, and rows are terminated by newlines. e.g.
  897. XX# prtboard: <1, 3, 2> => "Q__\n__Q\n_Q_\n", where \n represents new line.
  898. XXDef prtboard mergelines o trans o aa prtcol o distr o [id, length]
  899. XX
  900. XX# prtcol : <row size> => printed form of the column containing the given row
  901. XXDef prtcol aa (= -> _'Q; _'_) o distl o [1, iota o 2]
  902. XX
  903. XX# mergelines: <str1..strn> => str, where str is the concatenation of the
  904. XX# stri's separated by newlines
  905. XXDef mergelines append o aa (append o [id, newline])
  906. SHAR_EOF
  907. if test 1801 -ne "`wc -c nqueens.fp`"
  908. then
  909. echo shar: error transmitting nqueens.fp '(should have been 1801 characters)'
  910. fi
  911. echo shar: extracting parprimes.fp '(216 characters)'
  912. sed 's/^XX//' << \SHAR_EOF > parprimes.fp
  913. XXDef elim (bu = 0) o mod o reverse -> _<>;
  914. XX     [2]
  915. XXDef filter null o 2 -> 2;
  916. XX           /(/apndl o apndr) o aa elim o distl
  917. XXDef sieve null -> id;
  918. XX      apndl o [1, sieve o filter o [1, tl]]
  919. XXDef parprimes sieve o tl o iota
  920. SHAR_EOF
  921. if test 216 -ne "`wc -c parprimes.fp`"
  922. then
  923. echo shar: error transmitting parprimes.fp '(should have been 216 characters)'
  924. fi
  925. echo shar: extracting permsort.fp '(415 characters)'
  926. sed 's/^XX//' << \SHAR_EOF > permsort.fp
  927. XXDef permute append o aa append o aa aa (= o [1 o 1, 2] -> [2 o 1]; _<>) o
  928. XX       aa distr o distl o [id, iota o length]
  929. XX    # permute : <<i1, x1>,..<in, xn>> where {iy} = 1..n ==> <xj,..xk>
  930. XX    #    where ij = 1, ik = n and so on for the intermediate i's
  931. XXDef rank \/+ o aa ( < -> _0; _1) o distl
  932. XX    # rank : <x, <x1,..xn>> ==> m where m is the number of xi's <= x
  933. XX
  934. XXDef permsort permute o trans o [aa rank o distr o [id, id], id]
  935. SHAR_EOF
  936. if test 415 -ne "`wc -c permsort.fp`"
  937. then
  938. echo shar: error transmitting permsort.fp '(should have been 415 characters)'
  939. fi
  940. echo shar: extracting powerset.fp '(346 characters)'
  941. sed 's/^XX//' << \SHAR_EOF > powerset.fp
  942. XX# powerset: <el1..eln> => powerset of <el1..eln>
  943. XX# e.g.    powerset: <>      => <<>>
  944. XX#    powerset: <e>      => <<>, <e>>
  945. XX#    powerset: <1 2>      => <<>, <1>, <2>, <1, 2>>
  946. XX#    powerset: <1 2 3> => <<>, <1>, <2>, <3>, <1, 2>, <1, 3>, <2, 3>,
  947. XX#                <1, 2, 3>>
  948. XX# and so on.
  949. XXDef powerset null -> [id];
  950. XX         append o [aa apndl o distl o [1, 2], 2] o [1, powerset o tl]
  951. SHAR_EOF
  952. if test 346 -ne "`wc -c powerset.fp`"
  953. then
  954. echo shar: error transmitting powerset.fp '(should have been 346 characters)'
  955. fi
  956. echo shar: extracting primes.fp '(223 characters)'
  957. sed 's/^XX//' << \SHAR_EOF > primes.fp
  958. XXDef filter null o 2 -> _<>;
  959. XX       (bu = 0) o mod o [1 o 2, 1] -> filter o [1, tl o 2];
  960. XX       apndl o [1 o 2, filter o [1, tl o 2]]
  961. XXDef sieve (null -> _<>;
  962. XX       apndl o [1, sieve o filter o [1, tl]])
  963. XXDef primes sieve o tl o iota
  964. SHAR_EOF
  965. if test 223 -ne "`wc -c primes.fp`"
  966. then
  967. echo shar: error transmitting primes.fp '(should have been 223 characters)'
  968. fi
  969. echo shar: extracting prims.fp '(8494 characters)'
  970. sed 's/^XX//' << \SHAR_EOF > prims.fp
  971. XX# prims.fp: test suite for any implementation of FP or FP/FFP
  972. XXDef prims [id, \/and] o
  973. XX      [testtl, testtlr,
  974. XX       testrotl, testrotr,
  975. XX       testid, testatom,
  976. XX       testdistl, testdistr,
  977. XX       testapndl, testapndr,
  978. XX       testeq, testnoteq,
  979. XX       testleq, testgeq,
  980. XX       testless, testgreater,
  981. XX       testplus, testminus,
  982. XX       testtimes, testdiv,
  983. XX       testneg, testmod,
  984. XX       testnull, testlength,
  985. XX       testtrans, testreverse,
  986. XX       testand, testor,
  987. XX       testnot, testiota]
  988. XX
  989. XXDef testand \/and o aa = o
  990. XX       (bu trans <F, F, F, T>) o aa and o _<<F, F>, <F, T>, <T, F>, <T, T>>
  991. XX
  992. XXDef testapndl \/and o aa = o
  993. XX       (bu trans <<a>, <a, b>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
  994. XX       aa apndl o
  995. XX         _<<a, <>>, <a, <b>>, <a, <b, c>>, <<>, <>>, <<a>, <>>,
  996. XX           <<a>, <<b>>>>
  997. XX
  998. XXDef testapndr \/and o aa = o
  999. XX       (bu trans <<a>, <a, b>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
  1000. XX       aa apndr o
  1001. XX         _<<<>, a>, <<a>, b>, <<a, b>, c>, <<>, <>>, <<>, <a>>,
  1002. XX           <<<a>>, <b>>>
  1003. XX
  1004. XXDef testatom \/and o aa = o
  1005. XX       (bu trans <T, T, T, T, T, T, T, F, F, F, F>) o
  1006. XX       aa atom o
  1007. XX        _<T, F, <>, 1, 1.0, a, 'a, "string", <vector>,
  1008. XX          <"vector">, <v, e, c, t, o, r>>
  1009. XX
  1010. XXDef testdistl \/and o aa = o
  1011. XX       (bu trans <<>, <<a, 1>>, <<b, 1>, <b, 2>>, <<<>, 1>,
  1012. XX              <<>, 2>, <<>, 3>>>) o
  1013. XX       aa distl o _<<x, <>>, <a, <1>>, <b, <1, 2>>, <<>, <1, 2, 3>>>
  1014. XX
  1015. XXDef testdistr \/and o aa = o
  1016. XX       (bu trans <<>, <<a, 1>>, <<a, 2>, <b, 2>>,
  1017. XX              <<a, <>>, <b, <>>, <c, <>>>>) o
  1018. XX       aa distr o _<<<>, x>, <<a>, 1>, <<a, b>, 2>, <<a, b, c>, <>>>
  1019. XX
  1020. XXDef testdiv \/and o aa = o
  1021. XX       (bu trans
  1022. XX        <1,   1,   0,   2,   -12,   -3,    6,
  1023. XX          1.0, 1.0, 0.5, 2.0, -8.75, -17.5, 6.25>) o
  1024. XX       aa div o
  1025. XX       _<<1, 1>, <10, 10>, <1, 2>, <2, 1>, <35, -3>, <-35, 17>, <-27, -4>,
  1026. XX         <1, 1.0>, <10.0, 10>, <1.0, 2.0>, <2.0, 1>, <35, -4.0>,
  1027. XX         <-35.0, 2.0>, <-25.0, -4.0>>
  1028. XX
  1029. XXDef testeq \/and o aa = o
  1030. XX       (bu trans
  1031. XX        <T, F, F, F, T, F, F, F, F, F,
  1032. XX         T, F, F, F, F, F, F, F, F,
  1033. XX         T, F, F, F, F, F, F, F, F,
  1034. XX         T, F, T, F, F, F, F, F, F, F,
  1035. XX         T, F, F, F, F, F, F,
  1036. XX         T, F, F, F, F, F, F,
  1037. XX         T, F, F, F, F, F, F,
  1038. XX         T, F, F, F, F, F, F, F, F,
  1039. XX         T, F>) o aa = o
  1040. XX       _<<1, 1>, <1, 0>, <1, a>, <1, 'a>, <1, 1.0>, <1, 0.99>,
  1041. XX        <1, <>>, <1, T>, <1, F>, <1, <1>>,
  1042. XX         <a, a>, <a, b>, <a, 1>, <a, 'a>, <a, 1.0>, <a, <>>,
  1043. XX        <a, T>, <a, F>, <a, <a>>,
  1044. XX         <'a, 'a>, <'a, 'b>, <'a, 1>, <'a, a>, <'a, 1.0>,
  1045. XX        <'a, <>>, <'a, T>, <'a, F>, <'a, <'a>>,
  1046. XX         <1.0, 1.0>, <1.0, 2.0>, <1.0, 1>, <1.1, 1>, <1.0, 'a>,
  1047. XX        <1.0, a>, <1.0, <>>, <1.0, T>, <1.0, F>, <1.0, <1.0>>,
  1048. XX         <T, T>, <T, 1>, <T, 'T>, <T, 1.0>, <T, <>>, <T, F>, <T, <T>>,
  1049. XX         <F, F>, <F, 1>, <F, 'F>, <F, 1.0>, <F, <>>, <F, T>, <F, <F>>,
  1050. XX         <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>,
  1051. XX        <<>, <<>>>,
  1052. XX         <<a>, <a>>, <<a>, <b>>, <<a>, 1>, <<a>, 'a>, <<a>, 1.0>,
  1053. XX        <<a>, <>>, <<a>, T>, <<a>, F>, <<a>, <<a>>>,
  1054. XX         <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <d>>, e>>,
  1055. XX         <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <f>>, e>>>
  1056. XX
  1057. XX# only test geq on atoms, chars and numbers. Particular implementations
  1058. XX# may have it defined for other values as well, but that is not portable
  1059. XXDef testgeq \/and o aa = o
  1060. XX       (bu trans <T, T, F, T, T, F, T, T, F, T, T, F, T, T, F, T, T, F>) o
  1061. XX       aa >= o
  1062. XX       _<<1, 0>, <1, 1>, <1, 2>,
  1063. XX         <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>,
  1064. XX         <1, 0.99>, <1, 1.0>, <1, 1.01>,
  1065. XX         <1.01, 1>, <1.0, 1>, <0.99, 1>,
  1066. XX         <m, a>, <m, m>, <m, z>,
  1067. XX         <'m, 'a>, <'m, 'm>, <'m, 'z>>
  1068. XX
  1069. XXDef testgreater \/and o aa = o
  1070. XX       (bu trans <T, F, F, T, F, F, T, F, F, T, F, F, T, F, F, T, F, F>) o
  1071. XX       aa > o
  1072. XX       _<<1, 0>, <1, 1>, <1, 2>,
  1073. XX         <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>,
  1074. XX         <1, 0.99>, <1, 1.0>, <1, 1.01>,
  1075. XX         <1.01, 1>, <1.0, 1>, <0.99, 1>,
  1076. XX         <m, a>, <m, m>, <m, z>,
  1077. XX         <'m, 'a>, <'m, 'm>, <'m, 'z>>
  1078. XX
  1079. XXDef testid \/and o aa = o
  1080. XX       (bu trans <1, a, 'a, 1.0, T, F, <>, "id", <id, 1, x>>) o
  1081. XX       aa id o  _<1, a, 'a, 1.0, T, F, <>, "id", <id, 1, x>>
  1082. XX
  1083. XXDef testiota \/and o aa = o
  1084. XX       (bu trans <<>, <1>, <1, 2>, <1, 2, 3, 4, 5, 6, 7, 8, 9, 10>>) o
  1085. XX       aa iota o _<0, 1, 2, 10>
  1086. XX
  1087. XXDef testlength \/and o aa = o
  1088. XX       (bu trans <0, 1, 1, 2, 3, 4, 10>) o
  1089. XX       aa length o
  1090. XX       _<<>, <1>, <<<>>>, <<a, b, c>, <d, e>>, "xyz", "four", "lenght ten">
  1091. XX
  1092. XXDef testleq \/and o aa = o
  1093. XX       (bu trans <F, T, T, F, T, T, F, T, T, F, T, T, F, T, T, F, T, T>) o
  1094. XX       aa <= o
  1095. XX       _<<1, 0>, <1, 1>, <1, 2>,
  1096. XX         <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>,
  1097. XX         <1, 0.99>, <1, 1.0>, <1, 1.01>,
  1098. XX         <1.01, 1>, <1.0, 1>, <0.99, 1>,
  1099. XX         <m, a>, <m, m>, <m, z>,
  1100. XX         <'m, 'a>, <'m, 'm>, <'m, 'z>>
  1101. XX
  1102. XXDef testless \/and o aa = o
  1103. XX       (bu trans <F, F, T, F, F, T, F, F, T, F, F, T, F, F, T, F, F, T>) o
  1104. XX       aa < o
  1105. XX       _<<1, 0>, <1, 1>, <1, 2>,
  1106. XX         <1.0, 0.99>, <1.0, 1.0>, <1.0, 1.01>,
  1107. XX         <1, 0.99>, <1, 1.0>, <1, 1.01>,
  1108. XX         <1.01, 1>, <1.0, 1>, <0.99, 1>,
  1109. XX         <m, a>, <m, m>, <m, z>,
  1110. XX         <'m, 'a>, <'m, 'm>, <'m, 'z>>
  1111. XX
  1112. XXDef testminus \/and o aa = o
  1113. XX       (bu trans <1, -1, 0, 11, -5, 3, -5>) o
  1114. XX       aa - o
  1115. XX       _<<1, 0>, <0, 1>, <1, 1>, <7, -4>, <-3, 2>, <-5, -8>, <-8, -3>>
  1116. XX
  1117. XXDef testmod \/and o aa = o
  1118. XX       (bu trans <0, 0, 1, 0, 1, 16, 3>) o
  1119. XX       aa mod o
  1120. XX       _<<1, 1>, <10, 10>, <1, 2>, <2, 1>, <35, -3>, <-35, 17>, <-27, -4>>
  1121. XX
  1122. XXDef testneg \/and o aa = o (bu trans <0, 0, 1, -1.0, 15.2, -17>) o
  1123. XX       aa neg o _<0, -0, -1, 1.0, -15.2, 17>
  1124. XX
  1125. XXDef testnot \/and o aa = o (bu trans <T, F>) o aa not o _<F, T>
  1126. XX
  1127. XXDef testnoteq \/and o aa = o
  1128. XX       (bu trans
  1129. XX        <F, T, T, T, F, T, T, T, T, T,
  1130. XX         F, T, T, T, T, T, T, T, T,
  1131. XX         F, T, T, T, T, T, T, T, T,
  1132. XX         F, T, F, T, T, T, T, T, T, T,
  1133. XX         F, T, T, T, T, T, T,
  1134. XX         F, T, T, T, T, T, T,
  1135. XX         F, T, T, T, T, T, T,
  1136. XX         F, T, T, T, T, T, T, T, T,
  1137. XX         F, T>) o aa != o
  1138. XX       _<<1, 1>, <1, 0>, <1, a>, <1, 'a>, <1, 1.0>, <1, 0.99>,
  1139. XX        <1, <>>, <1, T>, <1, F>, <1, <1>>,
  1140. XX         <a, a>, <a, b>, <a, 1>, <a, 'a>, <a, 1.0>, <a, <>>,
  1141. XX        <a, T>, <a, F>, <a, <a>>,
  1142. XX         <'a, 'a>, <'a, 'b>, <'a, 1>, <'a, a>, <'a, 1.0>, <'a, <>>,
  1143. XX        <'a, T>, <'a, F>, <'a, <'a>>,
  1144. XX         <1.0, 1.0>, <1.0, 2.0>, <1.0, 1>, <1.1, 1>, <1.0, 'a>, <1.0, a>,
  1145. XX        <1.0, <>>, <1.0, T>, <1.0, F>, <1.0, <1.0>>,
  1146. XX         <T, T>, <T, 1>, <T, 'T>, <T, 1.0>, <T, <>>, <T, F>, <T, <T>>,
  1147. XX         <F, F>, <F, 1>, <F, 'F>, <F, 1.0>, <F, <>>, <F, T>, <F, <F>>,
  1148. XX         <<>, <>>, <<>, 1>, <<>, 'F>, <<>, 1.0>, <<>, T>, <<>, F>,
  1149. XX        <<>, <<>>>,
  1150. XX         <<a>, <a>>, <<a>, <b>>, <<a>, 1>, <<a>, 'a>, <<a>, 1.0>,
  1151. XX        <<a>, <>>, <<a>, T>, <<a>, F>, <<a>, <<a>>>,
  1152. XX         <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <d>>, e>>,
  1153. XX         <<a, <b>, <c, <d>>, e>, <a, <b>, <c, <f>>, e>>>
  1154. XX
  1155. XXDef testnull \/and o aa = o
  1156. XX       (bu trans <T, F, F, F, F, F, F, T, F, F, F>) o
  1157. XX       aa null o _<<>, 0, 1, a, '0, T, F, "", "nil", <nil>,
  1158. XX               <m, <o, n>, <<s>, t, e>, r>>
  1159. XX
  1160. XXDef testor \/and o aa = o
  1161. XX       (bu trans <F, T, T, T>) o aa or o _<<F, F>, <F, T>, <T, F>, <T, T>>
  1162. XX
  1163. XXDef testplus \/and o aa = o
  1164. XX       (bu trans <0, 2, 1, 1, -2, 3, -9>) o
  1165. XX       aa + o _<<0, 0>, <1, 1>, <1, 0>, <0, 1>, <1, -3>, <-5, 8>, <-4, -5>>
  1166. XX
  1167. XXDef testreverse \/and o aa = o
  1168. XX       (bu trans
  1169. XX           <<>, <a>, <b, a>, <4, 3, 2, 1>, <<e, f>, <c, d>, <a, b>>>) o
  1170. XX       aa reverse o
  1171. XX       _<<>, <a>, <a, b>, <1, 2, 3, 4>, <<a, b>, <c, d>, <e, f>>>
  1172. XX
  1173. XXDef testrotl \/and o aa = o
  1174. XX       (bu trans
  1175. XX           <<>, <a>, <b, a>, <2, 3, 4, 5, 1>, <<r, s>, <t, u>, <p, q>>>) o
  1176. XX       aa rotl o
  1177. XX       _<<>, <a>, <a, b>, <1, 2, 3, 4, 5>, <<p, q>, <r, s>, <t, u>>>
  1178. XX
  1179. XXDef testrotr \/and o aa = o
  1180. XX       (bu trans
  1181. XX           <<>, <a>, <b, a>, <5, 1, 2, 3, 4>, <<t, u>, <p, q>, <r, s>>>) o
  1182. XX       aa rotr o
  1183. XX       _<<>, <a>, <a, b>, <1, 2, 3, 4, 5>, <<p, q>, <r, s>, <t, u>>>
  1184. XX
  1185. XXDef testtimes \/and o aa = o
  1186. XX       (bu trans <0, 0, 0, 9, -2, -4, 6, 6, 28, -18, -10>) o
  1187. XX       aa * o
  1188. XX       _<<0, 0>, <0, 5>, <1, 0>, <1, 9>, <1, -2>, <-1, 4>, <-1, -6>,
  1189. XX         <-2, -3>, <4, 7>, <-6, 3>, <5, -2>>
  1190. XX
  1191. XXDef testtl \/and o aa = o
  1192. XX       (bu trans <<>, <a>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
  1193. XX       aa tl o
  1194. XX       _<<a>, <1, a>, <z, a, b, c>, <a, <>>, <x, <a>>, <<x>, <a>, <b>>>
  1195. XX
  1196. XXDef testtlr \/and o aa = o
  1197. XX       (bu trans <<>, <a>, <a, b, c>, <<>>, <<a>>, <<a>, <b>>>) o
  1198. XX       aa tlr o
  1199. XX       _<<a>, <a, b>, <a, b, c, d>, <<>, a>, <<a>, x>, <<a>, <b>, <c>>>
  1200. XX
  1201. XXDef testtrans \/and o aa = o
  1202. XX       (bu trans
  1203. XX        <<>, <>, <>,
  1204. XX         <<a>, <b>, <c>, <d>, <e>, <f>>, <<1, 2, 3, 4, 5>>,
  1205. XX         <<a, c>, <b, d>>, <<a, 1, x>, <b, 2, y>, <c, 3, z>>,
  1206. XX         <<a, 1, l>, <b, 2, m>, <c, 3, n>, <d, 4, o>, <e, 5, p>>>) o
  1207. XX       aa trans o
  1208. XX       _<<<>>, <<>, <>>, <<>, <>, <>, <>, <>>,
  1209. XX         <<a, b, c, d, e, f>>, <<1>, <2>, <3>, <4>, <5>>,
  1210. XX         <<a, b>, <c, d>>, <<a, b, c>, <1, 2, 3>, <x, y, z>>,
  1211. XX         <<a, b, c, d, e>, <1, 2, 3, 4, 5>, <l, m, n, o, p>>>
  1212. SHAR_EOF
  1213. if test 8494 -ne "`wc -c prims.fp`"
  1214. then
  1215. echo shar: error transmitting prims.fp '(should have been 8494 characters)'
  1216. fi
  1217. echo shar: extracting printf.fp '(3320 characters)'
  1218. sed 's/^XX//' << \SHAR_EOF > printf.fp
  1219. XX# printf.fp: provides fpprintf and fpscanf, functions defined like
  1220. XX# the corresponding C functions.
  1221. XX# e.g. fpprintf: <"hello %c %s\n", 'x, "string"> would return
  1222. XX#     "hello x string<newline>"
  1223. XX# for now, field lengths are not defined
  1224. XXDef fpprintf append o aa format o trans o [parsectrl, distformats]
  1225. XX
  1226. XX# parsectrl: "control %x string%y \n" => <"control %x", "string%y", " <nl>">
  1227. XXDef parsectrl breakup o
  1228. XX# next two lines, check that 1 is in the list of break up positions
  1229. XX          (null o 1 -> [_<1>, 2];
  1230. XX           (bu != 1) o 1 o 1 -> [(bu apndl 1) o 1, 2]; id) o
  1231. XX# next line, make sure that the last break-up position is needed
  1232. XX          (> o [1r o 1, length o 2] -> [tlr o 1, 2]; id) o
  1233. XX# figure out preliminary break-up positions, put newlines
  1234. XX          [append o aa parsebreak o pairpos o tl o allpairs,
  1235. XX           id] o subnewline o 1
  1236. XX
  1237. XX# parsebreak: <pos, <c1, c2>> => <> if c1 != %, <pos+2> if c1 = %
  1238. XXDef parsebreak (bu = '%) o 1 o 2 -> [(bu + 2) o 1]; _<>
  1239. XX
  1240. XX# subnewline: string => string with newline instead of every \n
  1241. XXDef subnewline append o aa subcharpair o tlr o allpairs
  1242. XX
  1243. XX# subcharpair: <c1, c2> => newline if c1 = \, c2 = n; <c1> otherwise
  1244. XXDef subcharpair (bu = '\\) o 2 -> _<>; (bu = "\n") -> newline; [2]
  1245. XX
  1246. XX# format: <ctrl-substring arg> => <new-substring>
  1247. XXDef format (bur < 2) o length o 1 -> 1;        # end of format string
  1248. XX       (bu != '%) o 2r o 1 -> 1;        # same
  1249. XX       (bu = 's) o 1r o 1 ->
  1250. XX        append o [tlr o tlr o 1, subnewline o 2];    # cat strings
  1251. XX       (bu = 'd) o 1r o 1 ->
  1252. XX        append o [tlr o tlr o 1, (bur numtostring 10) o 2];
  1253. XX       (bu = 'x) o 1r o 1 ->
  1254. XX        append o [tlr o tlr o 1, (bur numtostring 16) o 2];
  1255. XX       (bu = 'o) o 1r o 1 ->
  1256. XX        append o [tlr o tlr o 1, (bur numtostring 8) o 2];
  1257. XX       (bu = 'c) o 1r o 1 ->
  1258. XX        apndr o [tlr o tlr o 1, 2];
  1259. XX       (bu error "fpprintf: unknown format was used")
  1260. XX
  1261. XX# distformats: <format-string, other-args*> => <other-args*> or
  1262. XX# <other-args* format-string>, the former in the case that the last
  1263. XX# 2 elements of format-string are %c, where c is any character.
  1264. XXDef distformats (bur < 2) o length o 1 -> tl;
  1265. XX        (bu = '%) o 2r o 1 -> tl;
  1266. XX        rotl
  1267. XX
  1268. XX# numtostring: <n base> => "xyz", a string corresponding to the printable
  1269. XX# form, in the given base, of the number n.
  1270. XXDef numtostring (bur < 0) o 1 ->
  1271. XX            (bu apndl '-) o numtostring o [neg o 1, 2];
  1272. XX        aa printdigit o reverse o makedigits
  1273. XX
  1274. XX# makedigits: <n base> => <dig1, dig2 .. dign>, where digx < base
  1275. XXDef makedigits < -> [1]; apndl o [mod, makedigits o [div, 2]]
  1276. XX
  1277. XX# printdigit: n => the character corresponding to n (0 <= n < 16)
  1278. XXDef printdigit 1 o (bur seln "0123456789ABCDEF") o
  1279. XX           [(bu + 1), _1]
  1280. XX
  1281. XXDef charalpha or o [charupper, charlower]
  1282. XX
  1283. XXDef charupper and o [(bur >= 'A), (bu >= 'Z)]
  1284. XX
  1285. XXDef charlower and o [(bur >= 'a), (bu >= 'z)]
  1286. XX
  1287. XXDef chardigit and o [(bur >= '0), (bu >= '9)]
  1288. XX
  1289. XXDef charhexdig \/or o [chardigit,
  1290. XX            and o [(bur >= 'a), (bu >= 'f)],
  1291. XX            and o [(bur >= 'A), (bu >= 'F)]]
  1292. XX
  1293. XXDef charoctdig and o [(bur >= '0), (bu >= '7)]
  1294. XX
  1295. XXDef charspace or o [(bu = ' ), (bu = '    )]
  1296. XX
  1297. XXDef tstfpprintf [aa 2, \/and o aa =] o trans o [
  1298. XX_<"hi there,
  1299. XX274 high, 3D4F lo, -247 octal
  1300. XX",
  1301. XX  "how do you compute prime numbers 13 and 17?
  1302. XXa new result">,
  1303. XX        aa fpprintf o
  1304. XX        [[_"h%s\\n%d h%cgh, %x lo, %o octal%s",
  1305. XX          _"i there,", _274, _'i, _15695, _-167, newline],
  1306. XX         [_"how do %s prime numbers %d and %x?%sa new result",
  1307. XX          _"you compute", _13, _23, _"\\n"]]]
  1308. SHAR_EOF
  1309. if test 3320 -ne "`wc -c printf.fp`"
  1310. then
  1311. echo shar: error transmitting printf.fp '(should have been 3320 characters)'
  1312. fi
  1313. echo shar: extracting printhex.fp '(86 characters)'
  1314. sed 's/^XX//' << \SHAR_EOF > printhex.fp
  1315. XX# printhex.fp: print a number in hexadecimal notation
  1316. XXDef printhex bu fpprintf "%x\n"
  1317. SHAR_EOF
  1318. if test 86 -ne "`wc -c printhex.fp`"
  1319. then
  1320. echo shar: error transmitting printhex.fp '(should have been 86 characters)'
  1321. fi
  1322. echo shar: extracting qsort.fp '(211 characters)'
  1323. sed 's/^XX//' << \SHAR_EOF > qsort.fp
  1324. XXDef before append o aa ( > -> tl ; _<> )
  1325. XXDef same append o aa ( = -> tl ; _<> )
  1326. XXDef after append o aa ( < -> tl ; _<> )
  1327. XX
  1328. XXDef qsort null -> id;
  1329. XX      append o [qsort o before, same, qsort o after] o distl o [1, id]
  1330. SHAR_EOF
  1331. if test 211 -ne "`wc -c qsort.fp`"
  1332. then
  1333. echo shar: error transmitting qsort.fp '(should have been 211 characters)'
  1334. fi
  1335. echo shar: extracting selsort.fp '(221 characters)'
  1336. sed 's/^XX//' << \SHAR_EOF > selsort.fp
  1337. XXDef reorder atom o 2 -> reorder o [1, [2]];
  1338. XX            < o [1, 1 o 2] -> apndl;
  1339. XX        apndl o [1 o 2, apndl o [1, tl o 2]]
  1340. XX
  1341. XXDef selsort atom -> id;
  1342. XX        (bu >= 1) o length -> id;
  1343. XX        apndl o [1, selsort o tl] o /reorder
  1344. SHAR_EOF
  1345. if test 221 -ne "`wc -c selsort.fp`"
  1346. then
  1347. echo shar: error transmitting selsort.fp '(should have been 221 characters)'
  1348. fi
  1349. echo shar: extracting sort.out '(542 characters)'
  1350. sed 's/^XX//' << \SHAR_EOF > sort.out
  1351. XX<1,
  1352. XX11,
  1353. XX38,
  1354. XX43,
  1355. XX53,
  1356. XX59,
  1357. XX90,
  1358. XX136,
  1359. XX182,
  1360. XX230,
  1361. XX273,
  1362. XX302,
  1363. XX339,
  1364. XX350,
  1365. XX352,
  1366. XX364,
  1367. XX379,
  1368. XX381,
  1369. XX423,
  1370. XX424,
  1371. XX440,
  1372. XX455,
  1373. XX479,
  1374. XX538,
  1375. XX540,
  1376. XX579,
  1377. XX611,
  1378. XX615,
  1379. XX631,
  1380. XX639,
  1381. XX663,
  1382. XX680,
  1383. XX684,
  1384. XX699,
  1385. XX703,
  1386. XX720,
  1387. XX763,
  1388. XX785,
  1389. XX821,
  1390. XX827,
  1391. XX832,
  1392. XX914,
  1393. XX919,
  1394. XX929,
  1395. XX931,
  1396. XX940,
  1397. XX940,
  1398. XX941,
  1399. XX959,
  1400. XX970,
  1401. XX972,
  1402. XX1032,
  1403. XX1139,
  1404. XX1261,
  1405. XX1275,
  1406. XX1289,
  1407. XX1368,
  1408. XX1469,
  1409. XX1567,
  1410. XX2040,
  1411. XX2724,
  1412. XX3329,
  1413. XX3594,
  1414. XX3668,
  1415. XX3682,
  1416. XX3716,
  1417. XX3926,
  1418. XX4219,
  1419. XX4328,
  1420. XX4751,
  1421. XX4923,
  1422. XX5106,
  1423. XX5307,
  1424. XX5569,
  1425. XX5681,
  1426. XX5693,
  1427. XX5764,
  1428. XX6242,
  1429. XX6332,
  1430. XX6512,
  1431. XX6678,
  1432. XX6707,
  1433. XX6963,
  1434. XX7163,
  1435. XX7685,
  1436. XX7746,
  1437. XX7837,
  1438. XX7872,
  1439. XX7927,
  1440. XX7961,
  1441. XX8505,
  1442. XX8571,
  1443. XX8762,
  1444. XX9144,
  1445. XX9208,
  1446. XX9216,
  1447. XX9480,
  1448. XX9621,
  1449. XX9719,
  1450. XX9868>
  1451. SHAR_EOF
  1452. if test 542 -ne "`wc -c sort.out`"
  1453. then
  1454. echo shar: error transmitting sort.out '(should have been 542 characters)'
  1455. fi
  1456. echo shar: extracting sort.tst '(542 characters)'
  1457. sed 's/^XX//' << \SHAR_EOF > sort.tst
  1458. XX<53,
  1459. XX914,
  1460. XX827,
  1461. XX302,
  1462. XX631,
  1463. XX785,
  1464. XX230,
  1465. XX11,
  1466. XX1567,
  1467. XX350,
  1468. XX5307,
  1469. XX339,
  1470. XX929,
  1471. XX9216,
  1472. XX479,
  1473. XX703,
  1474. XX699,
  1475. XX90,
  1476. XX440,
  1477. XX3926,
  1478. XX1032,
  1479. XX3329,
  1480. XX3682,
  1481. XX5764,
  1482. XX615,
  1483. XX7961,
  1484. XX273,
  1485. XX1275,
  1486. XX38,
  1487. XX4923,
  1488. XX540,
  1489. XX43,
  1490. XX7837,
  1491. XX1368,
  1492. XX7746,
  1493. XX1469,
  1494. XX8505,
  1495. XX4328,
  1496. XX9480,
  1497. XX424,
  1498. XX6678,
  1499. XX1139,
  1500. XX763,
  1501. XX959,
  1502. XX6707,
  1503. XX6242,
  1504. XX663,
  1505. XX59,
  1506. XX6332,
  1507. XX455,
  1508. XX7685,
  1509. XX3716,
  1510. XX136,
  1511. XX720,
  1512. XX832,
  1513. XX4751,
  1514. XX5681,
  1515. XX5106,
  1516. XX379,
  1517. XX9719,
  1518. XX381,
  1519. XX919,
  1520. XX7163,
  1521. XX4219,
  1522. XX639,
  1523. XX1261,
  1524. XX2040,
  1525. XX9144,
  1526. XX941,
  1527. XX7872,
  1528. XX5569,
  1529. XX972,
  1530. XX364,
  1531. XX684,
  1532. XX931,
  1533. XX423,
  1534. XX7927,
  1535. XX3594,
  1536. XX182,
  1537. XX611,
  1538. XX1,
  1539. XX9868,
  1540. XX680,
  1541. XX538,
  1542. XX940,
  1543. XX6512,
  1544. XX1289,
  1545. XX9621,
  1546. XX970,
  1547. XX3668,
  1548. XX5693,
  1549. XX352,
  1550. XX940,
  1551. XX9208,
  1552. XX8571,
  1553. XX579,
  1554. XX821,
  1555. XX6963,
  1556. XX2724,
  1557. XX8762>
  1558. SHAR_EOF
  1559. if test 542 -ne "`wc -c sort.tst`"
  1560. then
  1561. echo shar: error transmitting sort.tst '(should have been 542 characters)'
  1562. fi
  1563. echo shar: extracting whilefact.fp '(130 characters)'
  1564. sed 's/^XX//' << \SHAR_EOF > whilefact.fp
  1565. XXDef nonnull (bu != 0) o 2
  1566. XXDef multdecr [ * o [1, 2], - o [2, _1]]
  1567. XXDef wfact while nonnull multdecr
  1568. XXDef whilefact 1 o (bu wfact 1)
  1569. SHAR_EOF
  1570. if test 130 -ne "`wc -c whilefact.fp`"
  1571. then
  1572. echo shar: error transmitting whilefact.fp '(should have been 130 characters)'
  1573. fi
  1574. echo shar: done with directory main
  1575. cd ..
  1576. #    End of shell archive
  1577. exit 0
  1578.  
  1579. -- 
  1580. Please send comp.sources.unix-related mail to rsalz@uunet.uu.net.
  1581. Use a domain-based address or give alternate paths, or you may lose out.
  1582.